home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume3 / turbo_tools / part1 < prev    next >
Encoding:
Internet Message Format  |  1986-11-30  |  49.0 KB
  1. From: talcott!cmcl2!lanl!jp (James Potter)
  2. Subject: Software Tools in Turbo Pascal (Part 1 of 2)
  3. Newsgroups: mod.sources
  4. Approved: jpn@panda.UUCP
  5.  
  6. Mod.sources:  Volume 3, Issue 33
  7. Submitted by: talcott!cmcl2!lanl!jp (James Potter)
  8.  
  9.  
  10.  
  11. #! /bin/sh
  12. # This is a shell archive, meaning:
  13. # 1. Remove everything above the #! /bin/sh line.
  14. # 2. Save the resulting text in a file.
  15. # 3. Execute the file with /bin/sh (not csh) to create the files:
  16. #    README.V30
  17. #    shell.pas
  18. #    initcmd.pas
  19. #    toolu.pas
  20. #    fprims.pas
  21. #    chapter7.pas
  22. #    chapter8.pas
  23. # This archive created: Sun Dec  1 16:36:52 1985
  24. export PATH; PATH=/bin:$PATH
  25. echo shar: extracting "'README.V30'" '(3049 characters)'
  26. if test -f 'README.V30'
  27. then
  28.     echo shar: will not over-write existing file "'README.V30'"
  29. else
  30. cat << \SHAR_EOF > 'README.V30'
  31. {readme.v30}
  32.  
  33. TURBTOOL.LBR DOCUMENTATION
  34.  
  35. This library contains the source from the book
  36. "Software Tools in Pascal" by B.W. Kernighan and
  37. P.J. Plauger, Addison-Wesley. It has been adapted
  38. for Turbo Pascal.
  39.  
  40. How to Implement:
  41.  
  42.   Compile SHELL.PAS with the CMD option
  43.   Execute SHELL
  44.  
  45. Accepts redirection, but not pipes.
  46. Bill McGee, 613-828-9130
  47.  
  48. Notes: The version using TURBO is fast enough to make
  49. this a useful set of tools for file manipulation.
  50.  
  51.           ------Further Modifications------
  52.  
  53. The primitives in this version are basically the UCSD Pascal versions
  54. presented in the book, with modifications for Turbo Pascal.
  55.  
  56. This version has been modified for use under Turbo Pascal v. 3.0
  57. under CP/M-86.  There are no system dependent statements in the code
  58. to the best of my knowledge, so it should work under MS-DOS as well.
  59.  
  60. The original version (typed in by Bill McGee) was set up for CP/M-80 and
  61. used the CHAIN capability of Turbo Pascal.  I have eliminated that
  62. feature in favor of using INCLUDE files.  There is not enough memory
  63. available in a CP/M-80 system for this version, but one could modify
  64. the include file list to eliminate unwanted features or to make more
  65. than one version, (e.g. break out EDIT, FORMAT, and DEFINE).
  66.  
  67. There was really only one change required to the McGee's original to get
  68. it to work with version 3.0.  A readln(TRM) had to be added in the
  69. subroutine GETKBD.  The change to CP/M-86 required replacing all calls
  70. to the procedure BDOS(0,0) with HALT.  This change works with the CP/M-80
  71. version of Turbo Pascal v. 3.0 as well.  Thus, as anyone can see, all of
  72. the hard work was done by Bill.
  73.  
  74. (Adaption to version 3.0 of Turbo Pascal by Jim Potter, (505) 662-5804.)
  75.  
  76. Please note that this is copyright software.  The following notice has
  77. been included with each file and should not be removed.
  78.  
  79. +-------------------------------------------------------------------------+
  80. |       Copyright (c) 1981                                                |
  81. |       By:     Bell Telephone Laboratories, Inc. and                     |
  82. |               Whitesmith's Ltd.,                                        |
  83. |                                                                         |
  84. |       This software is derived from the book                            |
  85. |               "Software Tools in Pascal", by                            |
  86. |               Brian W. Kernighan and P. J. Plauger                      |
  87. |               Addison-Wesley, 1981                                      |
  88. |               ISBN 0-201-10342-7                                        |
  89. |                                                                         |
  90. |       Right is hereby granted to freely distribute or duplicate this    |
  91. |       software, providing distribution or duplication is not for profit |
  92. |       or other commercial gain and that this copyright notice remains   |
  93. |       intact.                                                           |
  94. +-------------------------------------------------------------------------+
  95.  
  96. SHAR_EOF
  97. if test 3049 -ne "`wc -c < 'README.V30'`"
  98. then
  99.     echo shar: error transmitting "'README.V30'" '(should have been 3049 characters)'
  100. fi
  101. fi # end of overwriting check
  102. echo shar: extracting "'shell.pas'" '(2654 characters)'
  103. if test -f 'shell.pas'
  104. then
  105.     echo shar: will not over-write existing file "'shell.pas'"
  106. else
  107. cat << \SHAR_EOF > 'shell.pas'
  108. {SHELL.PAS}
  109.  
  110. {
  111.         Copyright (c) 1981
  112.         By:     Bell Telephone Laboratories, Inc. and
  113.                 Whitesmith's Ltd.,
  114.  
  115.         This software is derived from the book
  116.                 "Software Tools in Pascal", by
  117.                 Brian W. Kernighan and P. J. Plauger
  118.                 Addison-Wesley, 1981
  119.                 ISBN 0-201-10342-7
  120.  
  121.         Right is hereby granted to freely distribute or duplicate this
  122.         software, providing distribution or duplication is not for profit
  123.         or other commercial gain and that this copyright notice remains
  124.         intact.
  125. }
  126.  
  127. PROGRAM TOOLS;
  128. {$I TOOLU.PAS}
  129. {$I INITCMD.PAS}
  130. {$I CHAPTER1.PAS}
  131. {$I CHAPTER2.PAS}
  132. {$I CHAPTER3.PAS}
  133. {$I CHAPTER4.PAS}
  134. {$I CHAPTER5.PAS}
  135. {$I CHAPTER6.PAS}
  136. {$I CHAPTER7.PAS}
  137. {$I CHAPTER8.PAS}
  138.  
  139.  
  140.  
  141. VAR
  142.   STR,STR1:STRING80;
  143.   COMMAND:XSTRING;
  144.   DONE:BOOLEAN;
  145.   I:INTEGER;
  146.  
  147.  
  148.  
  149.  
  150.  
  151. BEGIN {SHELL}
  152.  
  153. DONE:=FALSE;
  154. WHILE NOT DONE
  155. DO
  156.     BEGIN
  157.     INITCMD;
  158.     IF GETARG(1,COMMAND,MAXSTR)
  159.     THEN
  160.         BEGIN
  161.         STR:='';
  162.         STR1:='X';
  163.         FOR I:=1 TO XLENGTH(COMMAND)
  164.         DO
  165.             BEGIN
  166.             if COMMAND[I]in[97..122]
  167.             then
  168.                 str1[1]:=chr(command[i]-32)
  169.             ELSE STR1[1]:=chr(COMMAND[I]);
  170.             STR:=CONCAT(STR,STR1)
  171.             END;
  172.         if str = 'COPY' then copy
  173.         else if str = 'LINECOUNT' then linecount
  174.         else if str = 'WORDCOUNT' then wordcount
  175.         else if str = 'DETAB' then detab
  176.         else if str = 'ENTAB' then entab
  177.         else if str = 'OVERSTRIKE' then overstrike
  178.         else if str = 'COMPRESS' then compress
  179.         else if str = 'EXPAND' then expand
  180.         else if str = 'ECHO' then echo
  181.         else if str = 'TRANSLIT' then translit
  182.         else if str = 'COMPARE' then compare
  183.         else if str = 'INCLUDE' then include
  184.         else if str = 'CONCAT' then concat
  185.         else if str = 'PRINT' then print
  186.         else if str = 'MAKECOPY' then makecopy
  187.         else if str = 'ARCHIVE' then archive
  188.         else if str = 'SORT' then sort
  189.         else if str = 'UNIQUE' then unique
  190.         else if str = 'KWIC' then kwic
  191.         else if str = 'ROTATE' then writeln('ROTATE not directly supported.')
  192.         else if str = 'UNROTATE' then unrotate
  193.         else if str = 'FIND' then find
  194.         else if str = 'CHANGE' then change
  195.         else if str = 'EDIT' then edit
  196.         else if str = 'FORMAT' then format
  197.         else if str = 'DEFINE' then macro
  198.         else if str = 'MACRO' then macro
  199.         else if str = 'QUIT' then halt
  200.         ELSE
  201.             BEGIN
  202.             WRITELN('?');
  203.             DONE:=FALSE
  204.             END
  205.         END;
  206.     endcmd;
  207.     END;
  208.  
  209. END.
  210. SHAR_EOF
  211. if test 2654 -ne "`wc -c < 'shell.pas'`"
  212. then
  213.     echo shar: error transmitting "'shell.pas'" '(should have been 2654 characters)'
  214. fi
  215. fi # end of overwriting check
  216. echo shar: extracting "'initcmd.pas'" '(2249 characters)'
  217. if test -f 'initcmd.pas'
  218. then
  219.     echo shar: will not over-write existing file "'initcmd.pas'"
  220. else
  221. cat << \SHAR_EOF > 'initcmd.pas'
  222. {initcmd.pas}
  223.  
  224. {
  225.         Copyright (c) 1981
  226.         By:     Bell Telephone Laboratories, Inc. and
  227.                 Whitesmith's Ltd.,
  228.  
  229.         This software is derived from the book
  230.                 "Software Tools in Pascal", by
  231.                 Brian W. Kernighan and P. J. Plauger
  232.                 Addison-Wesley, 1981
  233.                 ISBN 0-201-10342-7
  234.  
  235.         Right is hereby granted to freely distribute or duplicate this
  236.         software, providing distribution or duplication is not for profit
  237.         or other commercial gain and that this copyright notice remains
  238.         intact.
  239. }
  240.  
  241. PROCEDURE INITCMD;
  242. VAR
  243.   FD:FILEDESC;
  244.   FNAME:XSTRING;
  245.   FT:FILTYP;
  246.   IDX:1..MAXSTR;
  247.   I,JSKIP:INTEGER;
  248.   JUNK:BOOLEAN;
  249.  
  250.  
  251. BEGIN
  252.   CMDFIL[STDIN]:=STDIO;
  253.   CMDFIL[STDOUT]:=STDIO;
  254.   CMDFIL[STDERR]:=STDIO;
  255.   FOR FD:=SUCC(STDERR) TO MAXOPEN DO
  256.     CMDFIL[FD]:=CLOSED;
  257.   WRITELN;
  258.   write('$ ');
  259.   FOR FT:= FIL1 TO FIL4 DO
  260.     CMDOPEN[FT]:=FALSE;
  261.   KBDN:=0;
  262.   if (not getline(cmdlin,STDIN,MAXSTR)) then error('NO CMDLINE');
  263. CMDARGS:=0;
  264.   JSKIP:=0;
  265.   IDX:=1;
  266.   WHILE ((CMDLIN[IDX]<>ENDSTR)
  267.     AND(CMDLIN[IDX]<>NEWLINE)) DO BEGIN
  268.       WHILE((CMDLIN[IDX]=BLANK)AND(JSKIP MOD 2 <>1))DO
  269.         IDX:=IDX+1;
  270.       IF(CMDLIN[IDX]<>NEWLINE) THEN BEGIN
  271.         CMDARGS:=CMDARGS+1;
  272.         CMDIDX[CMDARGS]:=IDX-JSKIP;
  273.         WHILE((CMDLIN[IDX]<>NEWLINE)AND
  274.           ((CMDLIN[IDX]<>BLANK)OR(JSKIP MOD 2 <>0)))DO BEGIN
  275.               IF (CMDLIN[IDX]=DQUOTE)THEN BEGIN
  276.                 JSKIP:=JSKIP+1;
  277.                 IDX:=IDX+1
  278.               END
  279.               ELSE BEGIN
  280.                 CMDLIN[IDX-JSKIP]:=CMDLIN[IDX];
  281.                 IDX:=IDX+1
  282.               END
  283.  
  284.             END;
  285.         CMDLIN[IDX-JSKIP]:=ENDSTR;
  286.         IDX:=IDX+1;
  287.         IF (CMDLIN[CMDIDX[CMDARGS]]=LESS) THEN BEGIN
  288.           XCLOSE(STDIN);
  289.           CMDIDX[CMDARGS]:=CMDIDX[CMDARGS]+1;
  290.           JUNK:=GETARG(CMDARGS,FNAME,MAXSTR);
  291.           FD:=MUSTOPEN(FNAME,IOREAD);
  292.           CMDARGS:=CMDARGS-1;
  293.         END
  294.         ELSE IF (CMDLIN[CMDIDX[CMDARGS]]=GREATER) THEN BEGIN
  295.           XCLOSE(STDOUT);
  296.           CMDIDX[CMDARGS]:=CMDIDX[CMDARGS]+1;
  297.           JUNK:=GETARG(CMDARGS,FNAME,MAXSTR);
  298.           FD:=MUSTCREATE(FNAME,IOWRITE);
  299.           CMDARGS:=CMDARGS-1;
  300.         END
  301.       END
  302.     END;
  303. END;
  304.  
  305.  
  306.  
  307. SHAR_EOF
  308. if test 2249 -ne "`wc -c < 'initcmd.pas'`"
  309. then
  310.     echo shar: error transmitting "'initcmd.pas'" '(should have been 2249 characters)'
  311. fi
  312. fi # end of overwriting check
  313. echo shar: extracting "'toolu.pas'" '(12173 characters)'
  314. if test -f 'toolu.pas'
  315. then
  316.     echo shar: will not over-write existing file "'toolu.pas'"
  317. else
  318. cat << \SHAR_EOF > 'toolu.pas'
  319. {toolu.pas}
  320.  
  321. {
  322.         Copyright (c) 1981
  323.         By:     Bell Telephone Laboratories, Inc. and
  324.                 Whitesmith's Ltd.,
  325.  
  326.         This software is derived from the book
  327.                 "Software Tools in Pascal", by
  328.                 Brian W. Kernighan and P. J. Plauger
  329.                 Addison-Wesley, 1981
  330.                 ISBN 0-201-10342-7
  331.  
  332.         Right is hereby granted to freely distribute or duplicate this
  333.         software, providing distribution or duplication is not for profit
  334.         or other commercial gain and that this copyright notice remains
  335.         intact.
  336. }
  337.  
  338. CONST
  339.   IOERROR=0;
  340.   STDIN=1;
  341.   STDOUT=2;
  342.   STDERR=3;
  343. (*IO RELEATED STUFF*)
  344.   MAXOPEN=7;
  345.   IOREAD=0;
  346.   IOWRITE=1;
  347.   MAXCMD=20;
  348.   ENDFILE=255;
  349.   BLANK=32;
  350.   ENDSTR=0;
  351.   MAXSTR=100;
  352.   BACKSPACE=8;
  353.   TAB=9;
  354.   NEWLINE=10;
  355.   EXCLAM=33;
  356.   DQUOTE=34;
  357.   SHARP=35;
  358.   DOLLAR=36;
  359.   PERCENT=37;
  360.   AMPER=38;
  361.   SQUOTE=39;
  362.   ACUTE=SQUOTE;
  363.   LPAREN=40;
  364.   RPAREN=41;
  365.   STAR=42;
  366.   PLUS=43;
  367.   COMMA=44;
  368.   MINUS=45;
  369.   DASH=MINUS;
  370.   PERIOD=46;
  371.   SLASH=47;
  372.   COLON=58;
  373.   SEMICOL=59;
  374.   LESS=60;
  375.   EQUALS=61;
  376.   GREATER=62;
  377.   QUESTION=63;
  378.   ATSIGN=64;
  379.   ESCAPE=ATSIGN;
  380.   LBRACK=91;
  381.   BACKSLASH=92;
  382.   RBRACK=93;
  383.   CARET=94;
  384.   GRAVE=96;
  385.   UNDERLINE=95;
  386.   TILDE=126;
  387.   LBRACE=123;
  388.   BAR=124;
  389.   RBRACE=125;
  390.   
  391. TYPE
  392.    CHARACTER=0..255;
  393.    XSTRING=ARRAY[1..MAXSTR]OF CHARACTER;
  394.   STRING80=string[80];
  395.   FILEDESC=IOERROR..MAXOPEN;
  396.   FILTYP=(CLOSED,STDIO,FIL1,FIL2,FIL3,FIL4);
  397.  
  398. VAR
  399.    KBDN,KBDNEXT:INTEGER;
  400.    KBDLINE:XSTRING;
  401.    CMDARGS:0..MAXCMD;
  402.    CMDIDX:ARRAY[1..MAXCMD] OF 1..MAXSTR;
  403.    CMDLIN:XSTRING;
  404.    CMDLINE:STRING80;
  405.    CMDFIL:ARRAY[STDIN..MAXOPEN]OF FILTYP;
  406.    CMDOPEN:ARRAY[FILTYP]OF BOOLEAN;
  407.    FILE1,FILE2,FILE3,FILE4:TEXT;
  408.    
  409.  
  410.  
  411. FUNCTION GETKBD(VAR C:CHARACTER):CHARACTER;FORWARD;
  412. FUNCTION FGETCF(VAR FIL:TEXT):CHARACTER;FORWARD;
  413. FUNCTION GETCF(VAR C:CHARACTER;FD:FILEDESC):CHARACTER;FORWARD;
  414. FUNCTION GETC(VAR C:CHARACTER):CHARACTER;FORWARD;
  415. PROCEDURE FPUTCF(C:CHARACTER;VAR FIL:TEXT);FORWARD;
  416. PROCEDURE PUTCF(C:CHARACTER;FD:FILEDESC);FORWARD;
  417. PROCEDURE PUTC(C:CHARACTER);FORWARD;
  418. PROCEDURE PUTDEC(N,W:INTEGER);FORWARD;
  419. FUNCTION ITOC(N:INTEGER;VAR S:XSTRING;I:INTEGER):INTEGER;FORWARD;
  420. FUNCTION GETARG(N:INTEGER;VAR S:XSTRING;
  421.   MAXSIZE:INTEGER):BOOLEAN;FORWARD;
  422.   PROCEDURE SCOPY(VAR SRC:XSTRING;I:INTEGER;VAR DEST:XSTRING;J:INTEGER);FORWARD;
  423. PROCEDURE ENDCMD;FORWARD;
  424. PROCEDURE XCLOSE(FD:FILEDESC);FORWARD;
  425. FUNCTION MUSTCREATE(VAR NAME:XSTRING;MODE:INTEGER):
  426. FILEDESC;FORWARD;
  427. FUNCTION CREATE(VAR NAME:XSTRING;MODE:INTEGER):FILEDESC;FORWARD;
  428. FUNCTION XLENGTH(VAR S:XSTRING):INTEGER;FORWARD;
  429. PROCEDURE STRNAME(VAR STR:STRING80;VAR XSTR:XSTRING);FORWARD;
  430. PROCEDURE ERROR(STR:STRING80);FORWARD;
  431. FUNCTION MAX(X,Y:INTEGER):INTEGER;FORWARD;
  432. PROCEDURE REMOVE(NAME:XSTRING);FORWARD;
  433. FUNCTION GETLINE(VAR STR:XSTRING;FD:FILEDESC;
  434.   SIZE:INTEGER):BOOLEAN;FORWARD;
  435.   FUNCTION OPEN(VAR NAME:XSTRING;MODE:INTEGER):
  436. FILEDESC;FORWARD;
  437. FUNCTION FDALLOC:FILEDESC;FORWARD;
  438. FUNCTION FTALLOC:FILTYP;FORWARD;
  439. FUNCTION NARGS:INTEGER;FORWARD;
  440. FUNCTION ADDSTR(C:CHARACTER;VAR OUTSET:XSTRING;
  441.   VAR J:INTEGER;MAXSET:INTEGER):BOOLEAN;FORWARD;
  442. PROCEDURE PUTSTR(STR:XSTRING;FD:FILEDESC);FORWARD;
  443. FUNCTION MUSTOPEN(VAR NAME:XSTRING;MODE:INTEGER):FILEDESC;FORWARD;
  444. FUNCTION MIN(X,Y:INTEGER):INTEGER;FORWARD;
  445. FUNCTION ISUPPER(C:CHARACTER):BOOLEAN;FORWARD;
  446. FUNCTION EQUAL(VAR STR1,STR2:XSTRING):BOOLEAN;FORWARD;
  447. FUNCTION INDEX(VAR S:XSTRING;C:CHARACTER):INTEGER;FORWARD;
  448. FUNCTION ISALPHANUM(C:CHARACTER):BOOLEAN;FORWARD;
  449. FUNCTION ESC(VAR S:XSTRING;VAR I:INTEGER):
  450.      CHARACTER;FORWARD;
  451. PROCEDURE FCOPY(FIN,FOUT:FILEDESC);FORWARD;
  452. FUNCTION CTOI(VAR S:XSTRING;VAR I:INTEGER):INTEGER;FORWARD;
  453. FUNCTION ISDIGIT(C:CHARACTER):BOOLEAN;FORWARD;
  454. FUNCTION ISLOWER(C:CHARACTER):BOOLEAN;FORWARD;
  455. FUNCTION ISLETTER(C:CHARACTER):BOOLEAN;FORWARD;
  456.  
  457. FUNCTION ISDIGIT;
  458. BEGIN
  459.   ISDIGIT:=C IN [ORD('0')..ORD('9')]
  460. END;
  461.  
  462. FUNCTION ISLOWER;
  463. BEGIN
  464.   ISLOWER:=C IN [97..122]
  465. END;
  466.  
  467. FUNCTION ISLETTER;
  468. BEGIN
  469.   ISLETTER:=C IN [65..90]+[97..122]
  470. END;
  471.  
  472. FUNCTION CTOI;
  473. VAR N,SIGN:INTEGER;
  474. BEGIN
  475.   WHILE (S[I]=BLANK) OR (S[I]=TAB)DO
  476.     I:=I+1;
  477.   IF(S[I]=MINUS) THEN
  478.     SIGN:=-1
  479.   ELSE
  480.     SIGN:=1;
  481.   IF(S[I]=PLUS)OR(S[I]=MINUS)THEN
  482.     I:=I+1;
  483.   N:=0;
  484.   WHILE(ISDIGIT(S[I])) DO BEGIN
  485.     N:=10*N+S[I]-ORD('0');
  486.     I:=I+1
  487.   END;
  488.   CTOI:=SIGN*N
  489. END;
  490.  
  491. PROCEDURE FCOPY;
  492. VAR
  493.   C:CHARACTER;
  494. BEGIN
  495.   WHILE(GETCF(C,FIN)<>ENDFILE) DO
  496.     PUTCF(C,FOUT)
  497. END;
  498.  
  499.  
  500.    
  501.  
  502. FUNCTION INDEX;
  503. VAR I:INTEGER;
  504. BEGIN
  505.   I:=1;
  506.   WHILE(S[I]<>C) AND (S[I]<>ENDSTR)DO
  507.     I:=I+1;
  508.   IF (S[I]=ENDSTR) THEN
  509.     INDEX:=0
  510.   ELSE
  511.     INDEX:=I
  512. END;
  513.  
  514. FUNCTION ESC;
  515. BEGIN
  516.   IF(S[I]<>ATSIGN) THEN
  517.     ESC:=S[I]
  518.   ELSE IF(S[I+1]=ENDSTR) THEN (*@ NOT SPECIAL AT END*)
  519.     ESC:=ATSIGN
  520.   ELSE BEGIN
  521.     I:=I+1;
  522.     IF(S[I]=ORD('N'))THEN ESC:=NEWLINE
  523.     ELSE IF (S[I]=ORD('T')) THEN
  524.       ESC:=TAB
  525.     ELSE
  526.       ESC:=S[I]
  527.   END
  528. END;
  529.  
  530. FUNCTION ISALPHANUM;
  531. BEGIN
  532.   ISALPHANUM:=C IN
  533.     [ORD('A')..ORD('Z'),ORD('0')..ORD('9'),
  534.     97..122]
  535. END;
  536.  
  537. FUNCTION MAX;
  538. BEGIN
  539.   IF(X>Y)THEN
  540.     MAX:=X
  541.   ELSE
  542.     MAX:=Y
  543. END;
  544.  
  545.  
  546. FUNCTION MIN;
  547. BEGIN
  548.   IF X<Y THEN
  549.     MIN:=X
  550.   ELSE
  551.     MIN:=Y
  552. END;
  553.  
  554.  
  555. FUNCTION ISUPPER;
  556.   BEGIN
  557.     ISUPPER:=C IN [ORD('A')..ORD('Z')]
  558.   END;
  559.  
  560.  
  561. FUNCTION XLENGTH;
  562. VAR
  563.   N:INTEGER;
  564. BEGIN
  565.   N:=1;
  566.   WHILE(S[N]<>ENDSTR)DO
  567.     N:=N+1;
  568.   XLENGTH:=N-1
  569. END;
  570.  
  571. FUNCTION GETARG;
  572. BEGIN
  573.   IF((N<1)OR(CMDARGS<N))THEN
  574.     GETARG:=FALSE
  575.   ELSE BEGIN
  576.     SCOPY(CMDLIN,CMDIDX[N],S,1);
  577.     GETARG:=TRUE
  578.   END
  579. END;(*GETARG*)
  580.  
  581.  
  582.   PROCEDURE SCOPY;
  583.   BEGIN
  584.     WHILE(SRC[I]<>ENDSTR)DO BEGIN
  585.       DEST[J]:=SRC[I];
  586.       I:=I+1;
  587.       J:=J+1
  588.     END;
  589.     DEST[J]:=ENDSTR;
  590.   END;
  591.   
  592.   
  593.   
  594. (*$I-*)
  595. FUNCTION CREATE;
  596. VAR
  597.   FD:FILEDESC;
  598.   SNM:STRING80;
  599. BEGIN
  600.   FD:=FDALLOC;
  601.   IF(FD<>IOERROR)THEN BEGIN
  602.   STRNAME(SNM,NAME);
  603.   CASE (CMDFIL[FD])OF
  604.   FIL1:
  605.     begin assign(FILE1,SNM);rewrite(FILE1) end;
  606.   FIL2:begin assign(FILE2,SNM);rewrite(FILE2) end;
  607.   FIL3:begin assign(FILE3,SNM);rewrite(FILE3) end;
  608.   FIL4:begin assign(FILE4,SNM);rewrite(FILE4) end
  609.   END;
  610.   IF(IORESULT<>0)THEN BEGIN
  611.     XCLOSE(FD);
  612.     FD:=IOERROR
  613.   END
  614. END;
  615. CREATE:=FD;
  616. END;
  617. (*$I+*)
  618.  
  619. PROCEDURE STRNAME;
  620. VAR I:INTEGER;
  621. BEGIN
  622.   STR:='.PAS';
  623.   I:=1;
  624.   WHILE(XSTR[I]<>ENDSTR)DO BEGIN
  625.     INSERT('X',STR,I);
  626.     STR[I]:=CHR(XSTR[I]);
  627.     I:=I+1
  628.   END
  629. END;
  630. PROCEDURE ERROR;
  631. BEGIN
  632.   WRITELN(STR);
  633.   HALT
  634. END;
  635.  
  636. FUNCTION MUSTCREATE;
  637. VAR
  638.   FD:FILEDESC;
  639. BEGIN
  640.   FD:=CREATE(NAME,MODE);
  641.   IF(FD=IOERROR)THEN BEGIN
  642.     PUTSTR(NAME,STDERR);
  643.     ERROR('  :CAN''T CREATE FILE')
  644.   END;
  645.   MUSTCREATE:=FD
  646. END;
  647.  
  648. FUNCTION NARGS;
  649. BEGIN
  650.   NARGS:=CMDARGS
  651. END;
  652.  
  653. PROCEDURE REMOVE;
  654. VAR
  655.   FD:FILEDESC;
  656. BEGIN
  657.   FD:=OPEN(NAME,IOREAD);
  658.   IF(FD=IOERROR)THEN
  659.   WRITELN('CAN''T REMOVE FILE')
  660.   ELSE BEGIN
  661.     CASE (CMDFIL[FD]) OF
  662.     FIL1:CLOSE(FILE1);
  663.     FIL2:CLOSE(FILE2);
  664.     FIL3:CLOSE(FILE3);
  665.     FIL4:CLOSE(FILE4);
  666.     END
  667.   END;
  668.   CMDFIL[FD]:=CLOSED
  669. END;
  670.  
  671. FUNCTION GETLINE;
  672. VAR I,ii:INTEGER;
  673.     DONE:BOOLEAN;
  674.     CH:CHARACTER;
  675. BEGIN
  676.  I:=0;
  677.  REPEAT
  678.    DONE:=TRUE;
  679.    CH:=GETCF(CH,FD);
  680.    IF(CH=ENDFILE) THEN
  681.      I:=0
  682.    ELSE IF (CH=NEWLINE) THEN BEGIN
  683.      I:=I+1;
  684.      STR[I]:=NEWLINE
  685.    END
  686.    ELSE IF (SIZE-2<=I) THEN BEGIN
  687.      WRITELN('LINE TOO LONG');
  688.      I:=I+1;
  689.      STR[I]:=NEWLINE
  690.    END
  691.    ELSE BEGIN
  692.      DONE:=FALSE;
  693.      I:=I+1;
  694.      STR[I]:=CH;
  695.    END
  696.  UNTIL(DONE);
  697.  STR[I+1]:=ENDSTR;
  698. GETLINE:=(0<I)
  699. END;(*GETLINE*)
  700.  
  701. (*$I-*)
  702. FUNCTION OPEN;
  703. VAR FD:FILEDESC;
  704. SNM:STRING80;
  705. BEGIN
  706.   FD:=FDALLOC;
  707.   IF(FD<>IOERROR) THEN BEGIN
  708.     STRNAME(SNM,NAME);
  709.     CASE (CMDFIL[FD]) OF
  710.     FIL1:begin assign(FILE1,SNM);RESET(FILE1) end;
  711.     FIL2:begin assign(FILE2,SNM);RESET(FILE2) end;
  712.     FIL3:begin assign(FILE3,SNM);RESET(FILE3) end;
  713.     FIL4:begin assign(FILE4,SNM);RESET(FILE4) end
  714.     END;
  715.     IF(IORESULT<>0) THEN BEGIN
  716.       XCLOSE(FD);
  717.       FD:=IOERROR
  718.     END
  719.   END;
  720.   OPEN:=FD
  721. END;
  722. (*$I+*)
  723.  
  724. FUNCTION FTALLOC;
  725. VAR DONE:BOOLEAN;
  726.    FT:FILTYP;
  727. BEGIN
  728.   FT:=FIL1;
  729.   REPEAT
  730.     DONE:=(NOT CMDOPEN[FT] OR (FT=FIL4));
  731.     IF(NOT DONE) THEN
  732.       FT:=SUCC(FT)
  733.   UNTIL (DONE);
  734.   IF(CMDOPEN[FT]) THEN
  735.     FTALLOC:=CLOSED
  736.   ELSE
  737.     FTALLOC:=FT
  738. END;
  739.  
  740. FUNCTION FDALLOC;
  741. VAR DONE:BOOLEAN;
  742. FD:FILEDESC;
  743. BEGIN
  744.   FD:=STDIN;
  745.   DONE:=FALSE;
  746.   WHILE(NOT DONE) DO
  747.     IF((CMDFIL[FD]=CLOSED) OR (FD=MAXOPEN))THEN
  748.       DONE:=TRUE
  749.     ELSE FD:=SUCC(FD);
  750.   IF(CMDFIL[FD]<>CLOSED) THEN
  751.     FDALLOC:=IOERROR
  752.   ELSE BEGIN
  753.     CMDFIL[FD]:=FTALLOC;
  754.     IF(CMDFIL[FD]=CLOSED) THEN
  755.       FDALLOC:=IOERROR
  756.     ELSE BEGIN
  757.       CMDOPEN[CMDFIL[FD]]:=TRUE;
  758.       FDALLOC:=FD
  759.     END
  760.   END
  761. END;(*FDALLOC*)
  762.  
  763.     PROCEDURE ENDCMD;
  764. VAR FD:FILEDESC;
  765. BEGIN
  766.   FOR FD:=STDIN TO MAXOPEN DO
  767.     XCLOSE(FD)
  768. END;
  769.  
  770. PROCEDURE XCLOSE;
  771. BEGIN
  772.   CASE (CMDFIL[FD])OF
  773.   CLOSED,STDIO:;
  774.   FIL1:CLOSE(FILE1);
  775.   FIL2:CLOSE(FILE2);
  776.   FIL3:CLOSE(FILE3);
  777.   FIL4:CLOSE(FILE4)
  778.   END;
  779.   CMDOPEN[CMDFIL[FD]]:=FALSE;
  780.   CMDFIL[FD]:=CLOSED
  781. END;
  782.  
  783. FUNCTION ADDSTR;
  784. BEGIN
  785.   IF(J>MAXSET)THEN
  786.     ADDSTR:=FALSE
  787.   ELSE BEGIN
  788.     OUTSET[J]:=C;
  789.     J:=J+1;
  790.     ADDSTR:=TRUE
  791.   END
  792. END;
  793.  
  794. PROCEDURE PUTSTR;
  795. VAR I:INTEGER;
  796. BEGIN
  797.   I:=1;
  798.   WHILE(STR[I]<>ENDSTR) DO BEGIN
  799.     PUTCF(STR[I],FD);
  800.     I:=I+1
  801.   END
  802. END;
  803. FUNCTION MUSTOPEN;
  804. VAR FD:FILEDESC;
  805. BEGIN
  806.   FD:=OPEN(NAME,MODE);
  807.   IF(FD=IOERROR)THEN BEGIN
  808.     PUTSTR(NAME,STDERR);
  809.     WRITELN(':  CAN''T OPEN FILE')
  810.   END;
  811.   MUSTOPEN:=FD
  812. END;
  813.  
  814. FUNCTION GETKBD;
  815.  
  816. VAR
  817.     DONE:BOOLEAN;
  818.     i:integer;
  819.     ch:char;
  820.  
  821. BEGIN
  822. IF (KBDN<=0)
  823. THEN
  824.     BEGIN
  825.     KBDNEXT:=1;
  826.     DONE:=FALSE;
  827.     if (kbdn=-2)
  828.     then
  829.         begin
  830.         readln;
  831.         kbdn:=0
  832.         end
  833.     else if (kbdn<0)
  834.     then
  835.         done:=true;
  836.     WHILE(NOT DONE)
  837.     DO
  838.         BEGIN
  839.         kbdn:=kbdn+1;
  840.         DONE:=TRUE;
  841.         if (eof(TRM))
  842.         then
  843.             kbdn:=-1
  844.         else if eoln(TRM)
  845.         then
  846.             begin
  847.             kbdline[kbdn]:=NEWLINE;
  848.             readln(TRM);
  849.             end
  850.         else if (MAXSTR-1<=kbdn)
  851.         then
  852.             begin
  853.             writeln('Line too long');
  854.             kbdline[kbdn]:=newline
  855.             end
  856.         ELSE
  857.             begin
  858.             read(TRM,ch);
  859.             kbdline[kbdn]:=ord(ch);
  860.             if (ord(ch)in [0..7,9..12,14..31])
  861.             then
  862.                 write('^',chr(ord(ch)+64))
  863.             else if (kbdline[kbdn]<>BACKSPACE)
  864.             then
  865.                 {do nothing}
  866.             ELSE
  867.                 begin
  868.                 write(ch,' ',ch);
  869.                 if (1<kbdn)
  870.                 then
  871.                     begin
  872.                     kbdn:=kbdn-2;
  873.                     if kbdline[kbdn+1]in[0..31]
  874.                     then
  875.                         write(ch,' ',ch)
  876.                     end
  877.                 ELSE
  878.                     kbdn:=kbdn-1
  879.                 end;
  880.             done:=false
  881.             end;
  882.         END
  883.     END;
  884. reset(TRM);
  885. IF(KBDN<=0)
  886. THEN
  887.     C:=ENDFILE
  888. ELSE
  889.     BEGIN
  890.     C:=KBDLINE[KBDNEXT];
  891.     KBDNEXT:=KBDNEXT+1;
  892.     if (c=NEWLINE)
  893.     then
  894.         begin
  895.         reset(TRM);
  896.         kbdn:=-2;
  897.         end
  898.     ELSE
  899.         KBDN:=KBDN-1
  900.     END;
  901.     GETKBD:=C
  902. END;
  903.  
  904.  FUNCTION FGETCF;
  905.  VAR CH:CHAR;
  906.  BEGIN
  907.    IF(EOF(FIL))THEN
  908.       FGETCF:=ENDFILE
  909.    ELSE IF(EOLN(FIL)) THEN BEGIN
  910.       READLN(FIL);
  911.       FGETCF:=NEWLINE
  912.    END
  913.    ELSE BEGIN
  914.      READ(FIL,CH);
  915.      FGETCF:=ORD(CH);
  916.    END;
  917.  END;
  918.  
  919.  FUNCTION GETCF;
  920.  BEGIN
  921.    CASE(CMDFIL[FD])OF
  922.    STDIO:C:=GETKBD(C);
  923.    FIL1:C:=FGETCF(FILE1);
  924.    FIL2:C:=FGETCF(FILE2);
  925.    FIL3:C:=FGETCF(FILE3);
  926.    FIL4:C:=FGETCF(FILE4);
  927.    END;
  928.  
  929.    GETCF:=C
  930.  END;
  931.  
  932. FUNCTION GETC;
  933. BEGIN
  934.   GETC:=GETCF(C,STDIN)
  935. END;
  936.  
  937.  PROCEDURE FPUTCF;
  938.  BEGIN
  939.   IF(C=NEWLINE)THEN
  940.     WRITELN(FIL)
  941.   ELSE
  942.     WRITE(FIL,CHR(C))
  943. END;
  944.  
  945. PROCEDURE PUTCF;
  946. BEGIN
  947.   CASE (CMDFIL[FD]) OF
  948.   STDIO:FPUTCF(C,CON);
  949.   FIL1:FPUTCF(C,FILE1);
  950.   FIL2:FPUTCF(C,FILE2);
  951.   FIL3:FPUTCF(C,FILE3);
  952.   FIL4:FPUTCF(C,FILE4)
  953.   END
  954. END;
  955.  
  956.  
  957. PROCEDURE PUTC;
  958. BEGIN
  959.   PUTCF(C,STDOUT);
  960. END;
  961.  
  962. FUNCTION ITOC;
  963. BEGIN
  964.   IF(N<0)THEN BEGIN
  965.     S[I]:=ORD('-');
  966.     ITOC:=ITOC(-N,S,I+1);
  967.   END
  968.   ELSE BEGIN
  969.     IF (N>=10)THEN
  970.       I:=ITOC(N DIV 10,S, I);
  971.     S[I]:=N MOD 10 + ORD('0');
  972.     S[I+1]:=ENDSTR;
  973.     ITOC:=I+1;
  974.   END
  975. END;
  976.  
  977. PROCEDURE PUTDEC;
  978. VAR I,ND:INTEGER;
  979.   S:XSTRING;
  980. BEGIN
  981.   ND:=ITOC(N,S,1);
  982.   FOR I:=ND TO W DO
  983.     PUTC(BLANK);
  984.   FOR I:=1 TO ND-1 DO
  985.     PUTC(S[I])
  986. END;
  987.   
  988. FUNCTION EQUAL;
  989. VAR
  990.   I:INTEGER;
  991. BEGIN
  992.   I:=1;
  993.   WHILE(STR1[I]=STR2[I])AND(STR1[I]<>ENDSTR) DO
  994.     I:=I+1;
  995.   EQUAL:=(STR1[I]=STR2[I])
  996. END;
  997.  
  998.  
  999.  
  1000.  
  1001. SHAR_EOF
  1002. if test 12173 -ne "`wc -c < 'toolu.pas'`"
  1003. then
  1004.     echo shar: error transmitting "'toolu.pas'" '(should have been 12173 characters)'
  1005. fi
  1006. fi # end of overwriting check
  1007. echo shar: extracting "'fprims.pas'" '(6206 characters)'
  1008. if test -f 'fprims.pas'
  1009. then
  1010.     echo shar: will not over-write existing file "'fprims.pas'"
  1011. else
  1012. cat << \SHAR_EOF > 'fprims.pas'
  1013. {fprims.pas}
  1014.  
  1015. {
  1016.         Copyright (c) 1981
  1017.         By:     Bell Telephone Laboratories, Inc. and
  1018.                 Whitesmith's Ltd.,
  1019.  
  1020.         This software is derived from the book
  1021.                 "Software Tools in Pascal", by
  1022.                 Brian W. Kernighan and P. J. Plauger
  1023.                 Addison-Wesley, 1981
  1024.                 ISBN 0-201-10342-7
  1025.  
  1026.         Right is hereby granted to freely distribute or duplicate this
  1027.         software, providing distribution or duplication is not for profit
  1028.         or other commercial gain and that this copyright notice remains
  1029.         intact.
  1030. }
  1031.  
  1032. CONST
  1033.   MAXPAT=MAXSTR;
  1034.   CLOSIZE=1;
  1035.   CLOSURE=STAR;
  1036.   BOL=PERCENT;
  1037.   EOL=DOLLAR;
  1038.   ANY=QUESTION;
  1039.   CCL=LBRACK;
  1040.   CCLEND=RBRACK;
  1041.   NEGATE=CARET;
  1042.   NCCL=EXCLAM;
  1043.   LITCHAR=67;
  1044.  
  1045. FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  1046.   DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  1047. FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  1048.   VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
  1049. FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;
  1050. FUNCTION MAKEPAT;
  1051. VAR
  1052.   I,J,LASTJ,LJ:INTEGER;
  1053.   DONE,JUNK:BOOLEAN;
  1054.  
  1055. FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  1056.   VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
  1057. VAR
  1058.   JSTART:INTEGER;
  1059.   JUNK:BOOLEAN;
  1060.  
  1061. PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  1062.   VAR I:INTEGER; VAR DEST:XSTRING;
  1063.   VAR J:INTEGER; MAXSET:INTEGER);
  1064. CONST ESCAPE=ATSIGN;
  1065. VAR K:INTEGER;
  1066. JUNK:BOOLEAN;
  1067.  
  1068. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  1069. BEGIN
  1070.   IF(S[I]<>ESCAPE) THEN
  1071.     ESC:=S[I]
  1072.   ELSE IF (S[I+1]=ENDSTR) THEN
  1073.     ESC:=ESCAPE
  1074.   ELSE BEGIN
  1075.     I:=I+1;
  1076.     IF (S[I]=ORD('N')) THEN
  1077.       ESC:=NEWLINE
  1078.     ELSE IF (S[I]=ORD('T')) THEN
  1079.       ESC:=TAB
  1080.     ELSE
  1081.       ESC:=S[I]
  1082.     END
  1083. END;
  1084.  
  1085. BEGIN
  1086.   WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
  1087.     IF(SRC[I]=ESCAPE)THEN
  1088.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  1089.     ELSE IF (SRC[I]<>DASH) THEN
  1090.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  1091.     ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
  1092.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  1093.     ELSE IF (ISALPHANUM(SRC[I-1]))
  1094.       AND (ISALPHANUM(SRC[I+1]))
  1095.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  1096.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  1097.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  1098.             I:=I+1
  1099.     END
  1100.     ELSE
  1101.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  1102.     I:=I+1
  1103.   END
  1104. END;
  1105.  
  1106. BEGIN
  1107.   I:=I+1;
  1108.   IF(ARG[I]=NEGATE) THEN BEGIN
  1109.     JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
  1110.     I:=I+1
  1111.   END
  1112.   ELSE
  1113.     JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  1114.   JSTART:=J;
  1115.   JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  1116.   DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  1117.   PAT[JSTART]:=J-JSTART-1;
  1118.   GETCCL:=(ARG[I]=CCLEND)
  1119. END;
  1120.  
  1121. PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  1122.   LASTJ:INTEGER);
  1123. VAR
  1124.   JP,JT:INTEGER;
  1125.   JUNK:BOOLEAN;
  1126. BEGIN
  1127.   FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
  1128.     JT:=JP+CLOSIZE;
  1129.     JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  1130.   END;
  1131.   J:=J+CLOSIZE;
  1132.   PAT[LASTJ]:=CLOSURE
  1133. END;
  1134.  
  1135. BEGIN
  1136.   J:=1;
  1137.   I:=START;
  1138.   LASTJ:=1;
  1139.   DONE:=FALSE;
  1140.   WHILE(NOT DONE) AND (ARG[I]<>DELIM)
  1141.     AND (ARG[I]<>ENDSTR) DO BEGIN
  1142.       LJ:=J;
  1143.       IF(ARG[I]=ANY) THEN
  1144.         JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
  1145.       ELSE IF (ARG[I]=BOL) AND (I=START) THEN
  1146.         JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
  1147.       ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
  1148.         JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
  1149.       ELSE IF (ARG[I]=CCL) THEN
  1150.         DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
  1151.       ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
  1152.         LJ:=LASTJ;
  1153.         IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
  1154.           DONE:=TRUE
  1155.         ELSE
  1156.           STCLOSE(PAT,J,LASTJ)
  1157.       END
  1158.       ELSE BEGIN
  1159.         JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
  1160.         JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
  1161.       END;
  1162.       LASTJ:=LJ;
  1163.       IF(NOT DONE) THEN
  1164.         I:=I+1
  1165.     END;
  1166.     IF(DONE) OR (ARG[I]<>DELIM) THEN
  1167.       MAKEPAT:=0
  1168.     ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
  1169.       MAKEPAT:=0
  1170.     ELSE
  1171.       MAKEPAT:=I
  1172.   END;
  1173.   
  1174.  
  1175. FUNCTION AMATCH;
  1176.  
  1177.  
  1178. VAR I,K:INTEGER;
  1179.    DONE:BOOLEAN;
  1180.  
  1181.  
  1182. FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  1183.   VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
  1184. VAR
  1185.   ADVANCE:-1..1;
  1186.  
  1187.  
  1188. FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  1189.   OFFSET:INTEGER):BOOLEAN;
  1190. VAR
  1191.   I:INTEGER;
  1192. BEGIN
  1193.   LOCATE:=FALSE;
  1194.   I:=OFFSET+PAT[OFFSET];
  1195.   WHILE(I>OFFSET) DO
  1196.     IF(C=PAT[I]) THEN BEGIN
  1197.       LOCATE :=TRUE;
  1198.       I:=OFFSET
  1199.     END
  1200.     ELSE
  1201.       I:=I-1
  1202. END;BEGIN
  1203.   ADVANCE:=-1;
  1204.   IF(LIN[I]=ENDSTR) THEN
  1205.     OMATCH:=FALSE
  1206.   ELSE IF (NOT( PAT[J] IN
  1207.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  1208.      ERROR('IN OMATCH:CAN''T HAPPEN')
  1209.   ELSE
  1210.     CASE PAT[J] OF
  1211.     LITCHAR:
  1212.       IF (LIN[I]=PAT[J+1]) THEN
  1213.         ADVANCE:=1;
  1214.     BOL:
  1215.       IF (I=1) THEN
  1216.         ADVANCE:=0;
  1217.     ANY:
  1218.       IF (LIN[I]<>NEWLINE) THEN
  1219.         ADVANCE:=1;
  1220.     EOL:
  1221.       IF(LIN[I]=NEWLINE) THEN
  1222.         ADVANCE:=0;
  1223.     CCL:
  1224.       IF(LOCATE(LIN[I],PAT,J+1)) THEN
  1225.         ADVANCE:=1;
  1226.     NCCL:
  1227.       IF(LIN[I]<>NEWLINE)
  1228.         AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
  1229.           ADVANCE:=1
  1230.         END;
  1231.     IF(ADVANCE>=0) THEN BEGIN
  1232.       I:=I+ADVANCE;
  1233.       OMATCH:=TRUE
  1234.     END
  1235.     ELSE
  1236.       OMATCH:=FALSE
  1237.   END;
  1238.   
  1239. FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
  1240. BEGIN
  1241.   IF(NOT (PAT[N] IN
  1242.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  1243.     ERROR('IN PATSIZE:CAN''T HAPPEN')
  1244.   ELSE
  1245.     CASE PAT[N] OF
  1246.       LITCHAR:PATSIZE:=2;
  1247.       BOL,EOL,ANY:PATSIZE:=1;
  1248.       CCL,NCCL:PATSIZE:=PAT[N+1]+2;
  1249.       CLOSURE:PATSIZE:=CLOSIZE
  1250.     END
  1251. END;
  1252.  
  1253. BEGIN
  1254.   DONE:=FALSE;
  1255.   WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
  1256.     IF(PAT[J]=CLOSURE) THEN BEGIN
  1257.       J:=J+PATSIZE(PAT,J);
  1258.       I:=OFFSET;
  1259.       WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
  1260.         IF (NOT OMATCH(LIN,I,PAT,J)) THEN
  1261.           DONE:=TRUE;
  1262.       DONE:=FALSE;
  1263.       WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
  1264.         K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
  1265.         IF(K>0) THEN
  1266.           DONE:=TRUE
  1267.         ELSE
  1268.           I:=I-1
  1269.       END;
  1270.       OFFSET:=K;
  1271.       DONE:=TRUE
  1272.     END
  1273.     ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
  1274.       THEN BEGIN
  1275.       OFFSET :=0;
  1276.       DONE:=TRUE
  1277.     END
  1278.     ELSE
  1279.       J:=J+PATSIZE(PAT,J);
  1280.   AMATCH:=OFFSET
  1281. END;
  1282. FUNCTION MATCH;
  1283.  
  1284. VAR
  1285.   I,POS:INTEGER;
  1286.  
  1287.   
  1288.                                                                                
  1289. BEGIN
  1290.   POS:=0;
  1291.   I:=1;
  1292.   WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
  1293.     POS:=AMATCH(LIN,I,PAT,1);
  1294.     I:=I+1
  1295.   END;
  1296.   MATCH:=(POS>0)
  1297. END;
  1298.  
  1299.  
  1300.  
  1301. SHAR_EOF
  1302. if test 6206 -ne "`wc -c < 'fprims.pas'`"
  1303. then
  1304.     echo shar: error transmitting "'fprims.pas'" '(should have been 6206 characters)'
  1305. fi
  1306. fi # end of overwriting check
  1307. echo shar: extracting "'chapter7.pas'" '(8627 characters)'
  1308. if test -f 'chapter7.pas'
  1309. then
  1310.     echo shar: will not over-write existing file "'chapter7.pas'"
  1311. else
  1312. cat << \SHAR_EOF > 'chapter7.pas'
  1313. {chapter7.pas}
  1314.  
  1315. {
  1316.         Copyright (c) 1981
  1317.         By:     Bell Telephone Laboratories, Inc. and
  1318.                 Whitesmith's Ltd.,
  1319.  
  1320.         This software is derived from the book
  1321.                 "Software Tools in Pascal", by
  1322.                 Brian W. Kernighan and P. J. Plauger
  1323.                 Addison-Wesley, 1981
  1324.                 ISBN 0-201-10342-7
  1325.  
  1326.         Right is hereby granted to freely distribute or duplicate this
  1327.         software, providing distribution or duplication is not for profit
  1328.         or other commercial gain and that this copyright notice remains
  1329.         intact.
  1330. }
  1331.  
  1332. PROCEDURE FORMAT;
  1333. CONST
  1334.   CMD=PERIOD;
  1335.   PAGENUM=SHARP;
  1336.   PAGEWIDTH=60;
  1337.   PAGELEN=66;
  1338.   HUGE=10000;
  1339. TYPE
  1340.   CMDTYPE=(BP,BR,CE,FI,FO,HE,IND,LS,NF,PL,
  1341.     RM,SP,TI,UL,UNKNOWN);
  1342. VAR
  1343.   CURPAGE,NEWPAGE,LINENO:INTEGER;
  1344.   PLVAL,M1VAL,M2VAL,M3VAL,M4VAL:INTEGER;
  1345.   BOTTOM:INTEGER;
  1346.   HEADER,FOOTER:XSTRING;
  1347.   
  1348.   FILL:BOOLEAN;
  1349.   LSVAL,SPVAL,INVAL,RMVAL,TIVAL,CEVAL,ULVAL:INTEGER;
  1350.  
  1351.   OUTP,OUTW,OUTWDS:INTEGER;
  1352.   OUTBUF:XSTRING;
  1353.   DIR:0..1;
  1354.   INBUF:XSTRING;
  1355.   
  1356. PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
  1357. BEGIN
  1358.   WHILE(S[I]=BLANK) OR(S[I]=TAB)DO
  1359.     I:=I+1
  1360.   END;
  1361.   
  1362. FUNCTION GETVAL(VAR BUF:XSTRING;VAR ARGTYPE:INTEGER):INTEGER;
  1363. VAR
  1364.   I:INTEGER;
  1365. BEGIN
  1366.   I:=1;
  1367.   WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
  1368.     I:=I+1;
  1369.   SKIPBL(BUF,I);
  1370.   ARGTYPE:=BUF[I];
  1371.   IF(ARGTYPE=PLUS) OR (ARGTYPE=MINUS) THEN
  1372.     I:=I+1;
  1373.   GETVAL:=CTOI(BUF,I)
  1374. END;
  1375.  
  1376. PROCEDURE SETPARAM(VAR PARAM:INTEGER;VAL,ARGTYPE,DEFVAL,MINVAL,MAXVAL:
  1377.   INTEGER);
  1378. BEGIN
  1379.   IF(ARGTYPE=NEWLINE)THEN
  1380.     PARAM:=DEFVAL
  1381.   ELSE IF (ARGTYPE=PLUS)THEN
  1382.     PARAM:=PARAM+VAL
  1383.   ELSE IF(ARGTYPE=MINUS) THEN
  1384.     PARAM:=PARAM-VAL
  1385.   ELSE PARAM:=VAL;
  1386.   PARAM:=MIN(PARAM,MAXVAL);
  1387.   PARAM:=MAX(PARAM,MINVAL)
  1388. END;
  1389.  
  1390. PROCEDURE SKIP(N:INTEGER);
  1391. VAR I:INTEGER;
  1392. BEGIN
  1393.   FOR I:=1 TO N DO
  1394.     PUTC(NEWLINE)
  1395. END;
  1396.  
  1397. PROCEDURE PUTTL(VAR BUF:XSTRING;PAGENO:INTEGER);
  1398. VAR I:INTEGER;
  1399. BEGIN
  1400.   FOR I:=1 TO XLENGTH(BUF) DO
  1401.     IF(BUF[I]=PAGENUM) THEN
  1402.       PUTDEC(PAGENO,1)
  1403.     ELSE
  1404.       PUTC(BUF[I])
  1405. END;
  1406.  
  1407. PROCEDURE PUTFOOT;
  1408. BEGIN
  1409.   SKIP(M3VAL);
  1410.   IF(M4VAL>0) THEN BEGIN
  1411.     PUTTL(FOOTER,CURPAGE);
  1412.     SKIP(M4VAL-1)
  1413.   END
  1414. END;
  1415.  
  1416. PROCEDURE PUTHEAD;
  1417. BEGIN
  1418.   CURPAGE:=NEWPAGE;
  1419.   NEWPAGE:=NEWPAGE+1;
  1420.   IF(M1VAL>0)THEN BEGIN
  1421.     SKIP(M1VAL-1);
  1422.     PUTTL(HEADER,CURPAGE)
  1423.   END;
  1424.   SKIP(M2VAL);
  1425.   LINENO:=M1VAL+M2VAL+1
  1426. END;
  1427.  
  1428. PROCEDURE PUT(VAR BUF:XSTRING);
  1429. VAR
  1430.   I:INTEGER;
  1431. BEGIN
  1432.   IF(LINENO<=0) OR(LINENO>BOTTOM) THEN
  1433.     PUTHEAD;
  1434.   FOR I:=1 TO INVAL+TIVAL DO
  1435.     PUTC(BLANK);
  1436.   TIVAL:=0;
  1437.   PUTSTR(BUF,STDOUT);
  1438.   SKIP(MIN(LSVAL-1,BOTTOM-LINENO));
  1439.   LINENO:=LINENO+LSVAL;
  1440.   IF(LINENO>BOTTOM)THEN PUTFOOT
  1441. END;
  1442.  
  1443.  
  1444. PROCEDURE BREAK;
  1445. BEGIN
  1446.   IF(OUTP>0) THEN BEGIN
  1447.     OUTBUF[OUTP]:=NEWLINE;
  1448.     OUTBUF[OUTP+1]:=ENDSTR;
  1449.     PUT(OUTBUF)
  1450.   END;
  1451.   OUTP:=0;
  1452.   OUTW:=0;
  1453.   OUTWDS:=0
  1454. END;
  1455.  
  1456. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  1457.   VAR OUT:XSTRING):INTEGER;
  1458. VAR
  1459.   J:INTEGER;
  1460. BEGIN
  1461.   WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
  1462.     I:=I+1;
  1463.   J:=1;
  1464.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  1465.     OUT[J]:=S[I];
  1466.     I:=I+1;
  1467.     J:=J+1
  1468.   END;
  1469.   OUT[J]:=ENDSTR;
  1470.   IF(S[I]=ENDSTR) THEN
  1471.     GETWORD:=0
  1472.   ELSE
  1473.     GETWORD:=I
  1474. END;
  1475.  
  1476. PROCEDURE LEADBL(VAR BUF:XSTRING);
  1477. VAR I,J:INTEGER;
  1478. BEGIN
  1479.   BREAK;
  1480.   I:=1;
  1481.   WHILE(BUF[I]=BLANK) DO
  1482.     I:=I+1;
  1483.   IF(BUF[I]<>NEWLINE) THEN
  1484.     TIVAL:=TIVAL+I-1;
  1485.   FOR J:=I TO XLENGTH(BUF)+1 DO
  1486.     BUF[J-I+1]:=BUF[J]
  1487. END;
  1488.  
  1489. PROCEDURE GETTL(VAR BUF,TTL:XSTRING);
  1490. VAR
  1491.   I:INTEGER;
  1492. BEGIN
  1493.   I:=1;
  1494.   WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
  1495.     I:=I+1;
  1496.   SKIPBL(BUF,I);
  1497.   IF(BUF[I]=SQUOTE) OR(BUF[I]=DQUOTE)THEN
  1498.     I:=I+1;
  1499.   SCOPY(BUF,I,TTL,1)
  1500. END;
  1501.  
  1502. PROCEDURE SPACE(N:INTEGER);
  1503. BEGIN
  1504.   BREAK;
  1505.   IF (LINENO<=BOTTOM) THEN BEGIN
  1506.     IF(LINENO<=0)THEN
  1507.       PUTHEAD;
  1508.     SKIP(MIN(N,BOTTOM+1-LINENO));
  1509.     LINENO:=LINENO+N;
  1510.     IF(LINENO>BOTTOM) THEN
  1511.       PUTFOOT
  1512.   END
  1513. END;
  1514.  
  1515. PROCEDURE PAGE;
  1516. BEGIN
  1517.   BREAK;
  1518.   IF(LINENO>0) AND (LINENO<=BOTTOM) THEN BEGIN
  1519.     SKIP(BOTTOM+1-LINENO);putfoot
  1520.   END;
  1521.   LINENO:=0
  1522. END;
  1523.  
  1524. FUNCTION WIDTH(VAR BUF:XSTRING):INTEGER;
  1525. VAR
  1526.   I,W:INTEGER;
  1527. BEGIN
  1528.   W:=0;
  1529.   I:=1;
  1530.   WHILE(BUF[I]<>ENDSTR) DO BEGIN
  1531.     IF (BUF[I] = BACKSPACE) THEN
  1532.       W:=W-1
  1533.     ELSE IF (BUF[I]<>NEWLINE) THEN
  1534.       W:=W+1;I:=I+1
  1535.   END;
  1536.   WIDTH:=W
  1537. END;
  1538.  
  1539. PROCEDURE SPREAD(VAR BUF:XSTRING;
  1540. OUTP,NEXTRA,OUTWDS:INTEGER);
  1541. VAR
  1542.   I,J,NB,NHOLES:INTEGER;
  1543. BEGIN
  1544.   IF(NEXTRA>0) AND (OUTWDS>1) THEN BEGIN
  1545.     DIR:=1-DIR;
  1546.     NHOLES:=OUTWDS-1;
  1547.     I:=OUTP-1;
  1548.     J:=MIN(MAXSTR-2,I+NEXTRA);
  1549.     WHILE(I<J) DO BEGIN
  1550.       BUF[J]:=BUF[I];
  1551.       IF(BUF[I]=BLANK) THEN BEGIN
  1552.         IF(DIR=0) THEN
  1553.           NB:=(NEXTRA-1) DIV NHOLES +1
  1554.         ELSE NB:=NEXTRA DIV NHOLES;
  1555.         NEXTRA:=NEXTRA - NB;
  1556.         NHOLES:=NHOLES-1;
  1557.         WHILE(NB>0) DO BEGIN
  1558.           J:=J-1;
  1559.           BUF[J]:=BLANK;
  1560.           NB:=NB-1
  1561.         END
  1562.       END;
  1563.       I:=I-1;
  1564.       J:=J-1
  1565.     END
  1566.   END
  1567. END;
  1568.  
  1569. PROCEDURE PUTWORD(VAR WORDBUF:XSTRING);
  1570. VAR
  1571.   LAST,LLVAL,NEXTRA,W:INTEGER;
  1572. BEGIN
  1573.   W:=WIDTH(WORDBUF);
  1574.   LAST:=XLENGTH(WORDBUF)+OUTP+1;
  1575.   LLVAL:=RMVAL-TIVAL-INVAL;
  1576.   IF(OUTP>0)
  1577.     AND ((OUTW+W>LLVAL) OR (LAST >=MAXSTR)) THEN BEGIN
  1578.       LAST:=LAST-OUTP;
  1579.       NEXTRA:=LLVAL-OUTW+1;
  1580.       IF(NEXTRA >0) AND(OUTWDS>1) THEN BEGIN
  1581.         SPREAD(OUTBUF,OUTP,NEXTRA,OUTWDS);
  1582.         OUTP:=OUTP+NEXTRA
  1583.       END;
  1584.       BREAK
  1585.     END;
  1586.     SCOPY(WORDBUF,1,OUTBUF,OUTP+1);
  1587.     OUTP:=LAST;
  1588.     OUTBUF[OUTP]:=BLANK;
  1589.     OUTW:=OUTW+W+1;
  1590.     OUTWDS:=OUTWDS+1
  1591. END;
  1592.  
  1593. PROCEDURE CENTER(VAR BUF:XSTRING);
  1594. BEGIN
  1595.   TIVAL:=MAX((RMVAL+TIVAL-WIDTH(BUF)) DIV 2,0)
  1596. END;
  1597.  
  1598. PROCEDURE UNDERLN (VAR BUF:XSTRING;SIZE:INTEGER);
  1599. VAR
  1600.   I,J:INTEGER;
  1601.   TBUF:XSTRING;
  1602. BEGIN
  1603.   J:=1;
  1604.   I:=1;
  1605.   WHILE(BUF[I]<>NEWLINE) AND (J<SIZE-1)DO BEGIN
  1606.     IF(ISALPHANUM(BUF[I])) THEN BEGIN
  1607.       TBUF[J]:=UNDERLINE;
  1608.       TBUF[J+1]:=BACKSPACE;
  1609.       J:=J+2
  1610.     END;
  1611.     TBUF[J]:=BUF[I];
  1612.     J:=J+1;
  1613.     I:=I+1
  1614.   END;
  1615.   TBUF[J]:=NEWLINE;
  1616.   TBUF[J+1]:=ENDSTR;
  1617.   SCOPY(TBUF,1,BUF,1)
  1618. END;
  1619.  
  1620. PROCEDURE TEXT(VAR INBUF:XSTRING);
  1621. VAR
  1622.   WORDBUF:XSTRING;
  1623.   I:INTEGER;
  1624. BEGIN
  1625.   IF(INBUF[1]=BLANK) OR (INBUF[1]=NEWLINE) THEN
  1626.     LEADBL(INBUF);
  1627.   IF(ULVAL>0) THEN BEGIN
  1628.     UNDERLN(INBUF,MAXSTR);
  1629.     ULVAL:=ULVAL-1
  1630.   END;
  1631.   IF(CEVAL>0)THEN BEGIN
  1632.     CENTER(INBUF);
  1633.     PUT(INBUF);
  1634.     CEVAL:=CEVAL-1
  1635.   END
  1636.   ELSE IF (INBUF[1]=NEWLINE)THEN
  1637.     PUT(INBUF)
  1638.   ELSE IF(NOT FILL) THEN
  1639.     PUT(INBUF)
  1640.   ELSE BEGIN
  1641.     I:=1;
  1642.     REPEAT
  1643.       I:=GETWORD(INBUF,I,WORDBUF);
  1644.       IF(I>0)THEN
  1645.         PUTWORD(WORDBUF)
  1646.       UNTIL(I=0)
  1647.     END
  1648.     
  1649. END;
  1650.   
  1651.  
  1652. PROCEDURE INITFMT;
  1653. BEGIN
  1654.   FILL:=TRUE;
  1655.   DIR:=0;
  1656.   INVAL:=0;
  1657.   RMVAL:=PAGEWIDTH;
  1658.   TIVAL:=0;
  1659.   LSVAL:=1;
  1660.   SPVAL:=0;
  1661.   CEVAL:=0;
  1662.   ULVAL:=0;
  1663.   LINENO:=0;
  1664.   CURPAGE:=0;
  1665.   NEWPAGE:=1;
  1666.   PLVAL:=PAGELEN;
  1667.   M1VAL:=3;M2VAL:=2;M3VAL:=2;M4VAL:=3;
  1668.   BOTTOM:=PLVAL-M3VAL-M4VAL;
  1669.   HEADER[1]:=NEWLINE;
  1670.   HEADER[2]:=ENDSTR;
  1671.   FOOTER[1]:=NEWLINE;
  1672.   FOOTER[2]:=ENDSTR;
  1673.   OUTP:=0;
  1674.   OUTW:=0;
  1675.   OUTWDS:=0
  1676. END;
  1677.  
  1678. FUNCTION GETCMD(VAR BUF:XSTRING):CMDTYPE;
  1679. VAR
  1680.   CMD:PACKED ARRAY[1..2] OF CHAR;
  1681. BEGIN
  1682.   CMD[1]:=CHR(BUF[2]);
  1683.   CMD[2]:=CHR(BUF[3]);
  1684.   IF(CMD='fi')THEN GETCMD:=FI
  1685.   ELSE IF (CMD='nf')THEN GETCMD:=NF
  1686.   ELSE IF (CMD='br')THEN GETCMD:=BR
  1687.   ELSE IF (CMD='ls')THEN GETCMD:=LS
  1688.   ELSE IF (CMD='bp')THEN GETCMD:=BP
  1689.   ELSE IF (CMD='sp')THEN GETCMD:=SP
  1690.   ELSE IF (CMD='in')THEN GETCMD:=IND
  1691.   ELSE IF (CMD='rm')THEN GETCMD:=RM
  1692.   ELSE IF (CMD='ce')THEN GETCMD:=CE
  1693.   ELSE IF (CMD='ti')THEN GETCMD:=TI
  1694.   ELSE IF (CMD='ul')THEN GETCMD:=UL
  1695.   ELSE IF (CMD='he') THEN GETCMD:=HE
  1696.   ELSE IF (CMD='fo') THEN GETCMD:=FO
  1697.   ELSE IF (CMD='pl') THEN GETCMD:=PL
  1698.   ELSE GETCMD:=UNKNOWN
  1699. END;
  1700.  
  1701. PROCEDURE COMMAND(VAR BUF:XSTRING);
  1702. VAR CMD:CMDTYPE;
  1703. ARGTYPE,SPVAL,VAL:INTEGER;
  1704. BEGIN
  1705.   CMD:=GETCMD(BUF);
  1706.   IF(CMD<>UNKNOWN)THEN
  1707.     VAL:=GETVAL(BUF,ARGTYPE);
  1708.     CASE CMD OF
  1709.     FI:BEGIN
  1710.        BREAK;
  1711.        FILL:=TRUE END;
  1712.     NF:BEGIN BREAK;
  1713.        FILL:=FALSE END;
  1714.     BR:BREAK;
  1715.     LS:SETPARAM(LSVAL,VAL,ARGTYPE,1,1,HUGE);
  1716.     CE:BEGIN BREAK;
  1717.        SETPARAM(CEVAL,VAL,ARGTYPE,1,0,HUGE) END;
  1718.     UL:SETPARAM(ULVAL,VAL,ARGTYPE,1,0,HUGE);
  1719.     HE:GETTL(BUF,HEADER);
  1720.     FO:GETTL(BUF,FOOTER);
  1721.     BP:BEGIN PAGE;
  1722.        SETPARAM(CURPAGE,VAL,ARGTYPE,CURPAGE+1,-HUGE,HUGE);
  1723.        NEWPAGE:=CURPAGE END;
  1724.     SP:BEGIN
  1725.        SETPARAM(SPVAL,VAL,ARGTYPE,1,0,HUGE);
  1726.        space(spval)
  1727.        END;
  1728.     IND:SETPARAM(INVAL,VAL,ARGTYPE,0,0,RMVAL-1);
  1729.     RM:SETPARAM(INVAL,VAL,ARGTYPE,PAGEWIDTH,
  1730.         INVAL+TIVAL+1,HUGE);
  1731.     TI:BEGIN BREAK;
  1732.        SETPARAM(TIVAL,VAL,ARGTYPE,0,-HUGE,RMVAL) END;
  1733.     PL:BEGIN
  1734.        SETPARAM(PLVAL,VAL,ARGTYPE,PAGELEN,
  1735.         M1VAL+M2VAL+M3VAL+M4VAL+1,HUGE);
  1736.        BOTTOM:=PLVAL-M3VAL-M4VAL END;
  1737.     UNKNOWN:
  1738.     END
  1739.   END;
  1740.  
  1741.        
  1742.        
  1743.  
  1744. BEGIN
  1745.   
  1746.   INITFMT;
  1747.   WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO
  1748.     IF(INBUF[1]=CMD) THEN
  1749.       COMMAND(INBUF)
  1750.     ELSE
  1751.       TEXT(INBUF);
  1752.     PAGE
  1753. END;
  1754.  
  1755.  
  1756.  
  1757. SHAR_EOF
  1758. if test 8627 -ne "`wc -c < 'chapter7.pas'`"
  1759. then
  1760.     echo shar: error transmitting "'chapter7.pas'" '(should have been 8627 characters)'
  1761. fi
  1762. fi # end of overwriting check
  1763. echo shar: extracting "'chapter8.pas'" '(12030 characters)'
  1764. if test -f 'chapter8.pas'
  1765. then
  1766.     echo shar: will not over-write existing file "'chapter8.pas'"
  1767. else
  1768. cat << \SHAR_EOF > 'chapter8.pas'
  1769. {chapter8.pas}
  1770.  
  1771. {
  1772.         Copyright (c) 1981
  1773.         By:     Bell Telephone Laboratories, Inc. and
  1774.                 Whitesmith's Ltd.,
  1775.  
  1776.         This software is derived from the book
  1777.                 "Software Tools in Pascal", by
  1778.                 Brian W. Kernighan and P. J. Plauger
  1779.                 Addison-Wesley, 1981
  1780.                 ISBN 0-201-10342-7
  1781.  
  1782.         Right is hereby granted to freely distribute or duplicate this
  1783.         software, providing distribution or duplication is not for profit
  1784.         or other commercial gain and that this copyright notice remains
  1785.         intact.
  1786. }
  1787.  
  1788. PROCEDURE MACRO;
  1789. CONST
  1790.   BUFSIZE=1000;
  1791.   MAXCHARS=500;
  1792.   MAXPOS=500;
  1793.   CALLSIZE=MAXPOS;
  1794.   ARGSIZE=MAXPOS;
  1795.   EVALSIZE=MAXCHARS;
  1796.   MAXDEF=MAXSTR;
  1797.   MAXTOK=MAXSTR;
  1798.   HASHSIZE=53;
  1799.   ARGFLAG=DOLLAR;
  1800. TYPE
  1801.   CHARPOS=1..MAXCHARS;
  1802.   CHARBUF=ARRAY[1..MAXCHARS]OF CHARACTER;
  1803.   POSBUF=ARRAY[1..MAXPOS]OF CHARPOS;
  1804.   POS=0..MAXPOS;
  1805.   STTYPE=(DEFTYPE,MACTYPE,IFTYPE,SUBTYPE,
  1806.   EXPRTYPE,LENTYPE,CHQTYPE);
  1807.   NDPTR=^NDBLOCK;
  1808.   NDBLOCK=RECORD
  1809.     NAME:CHARPOS;
  1810.     DEFN:CHARPOS;
  1811.     KIND:STTYPE;
  1812.     NEXTPTR:NDPTR
  1813.    END;
  1814.  
  1815. VAR
  1816.   BUF:ARRAY[1..BUFSIZE]OF CHARACTER;
  1817.   BP:0..BUFSIZE;
  1818.   HASHTAB:ARRAY[1..HASHSIZE]OF NDPTR;
  1819.   NDTABLE:CHARBUF;
  1820.   NEXTTAB:CHARPOS;
  1821.   CALLSTK:POSBUF;
  1822.   CP:POS;
  1823.   TYPESTK:ARRAY[1..CALLSIZE]OF STTYPE;
  1824.   PLEV:ARRAY[1..CALLSIZE]OF INTEGER;
  1825.   ARGSTK:POSBUF;
  1826.   AP:POS;
  1827.   EVALSTK:CHARBUF;
  1828.   EP:CHARPOS;
  1829.   (*BUILTINS*)
  1830.   DEFNAME:XSTRING;
  1831.   EXPRNAME:XSTRING;
  1832.   SUBNAME,IFNAME,LENNAME,CHQNAME:XSTRING;
  1833.   NULL:XSTRING;
  1834.   LQUOTE,RQUOTE:CHARACTER;
  1835.   DEFN,TOKEN:XSTRING;
  1836.   TOKTYPE:STTYPE;
  1837.   T:CHARACTER;
  1838.   NLPAR:INTEGER;
  1839. PROCEDURE PUTCHR(C:CHARACTER);
  1840. BEGIN
  1841.   IF(CP<=0) THEN
  1842.     PUTC(C)
  1843.   ELSE BEGIN
  1844.     IF(EP>EVALSIZE)THEN
  1845.       ERROR('MACRO:EVALUATION STACK OVERFLOW');
  1846.     EVALSTK[EP]:=C;
  1847.     EP:=EP+1
  1848.   END
  1849. END;
  1850.  
  1851. PROCEDURE PUTTOK(VAR S:XSTRING);
  1852. VAR
  1853.   I:INTEGER;
  1854. BEGIN
  1855.   I:=1;
  1856.   WHILE(S[I]<>ENDSTR) DO BEGIN
  1857.     PUTCHR(S[I]);
  1858.     I:=I+1
  1859.   END
  1860. END;
  1861.  
  1862.  
  1863. FUNCTION PUSH(EP:INTEGER;VAR ARGSTK:POSBUF;AP:INTEGER):INTEGER;
  1864. BEGIN
  1865.   IF(AP>ARGSIZE)THEN
  1866.     ERROR('MACRO:ARGUMENT STACK OVERFLOW');
  1867.   ARGSTK[AP]:=EP;
  1868.   PUSH:=AP+1
  1869. END;
  1870.  
  1871. PROCEDURE SCCOPY(VAR S:XSTRING;VAR CB:CHARBUF;
  1872. I:CHARPOS);
  1873. VAR J:INTEGER;
  1874. BEGIN
  1875.   J:=1;
  1876.   WHILE(S[J]<>ENDSTR)DO BEGIN
  1877.     CB[I]:=S[J];
  1878.     J:=J+1;
  1879.     I:=I+1
  1880.   END;
  1881.   CB[I]:=ENDSTR
  1882. END;
  1883.  
  1884. PROCEDURE CSCOPY(VAR CB:CHARBUF;I:CHARPOS;
  1885.   VAR S:XSTRING);
  1886. VAR J:INTEGER;
  1887. BEGIN
  1888.   J:=1;
  1889.   WHILE(CB[I]<>ENDSTR)DO BEGIN
  1890.     S[J]:=CB[I];
  1891.     I:=I+1;
  1892.     J:=J+1
  1893.   END;
  1894.   S[J]:=ENDSTR
  1895. END;
  1896.  
  1897.  
  1898. PROCEDURE PUTBACK(C:CHARACTER);
  1899. BEGIN
  1900.   IF(BP>=BUFSIZE)THEN
  1901.     WRITELN('TOO MANY CHARACTERS PUSHED BACK');
  1902.   BP:=BP+1;
  1903.   BUF[BP]:=C
  1904. END;
  1905.  
  1906. FUNCTION GETPBC(VAR C:CHARACTER):CHARACTER;
  1907. BEGIN
  1908.   IF(BP>0)THEN
  1909.     C:=BUF[BP]
  1910.   ELSE BEGIN
  1911.     BP:=1;
  1912.     BUF[BP]:=GETC(C)
  1913.   END;
  1914.   IF(C<>ENDFILE)THEN
  1915.     BP:=BP-1;
  1916.   GETPBC:=C
  1917. END;
  1918.  
  1919. FUNCTION GETTOK(VAR TOKEN:XSTRING;TOKSIZE:INTEGER):
  1920.   CHARACTER;
  1921. VAR I:INTEGER;
  1922.     DONE:BOOLEAN;
  1923. BEGIN
  1924.   I:=1;
  1925.   DONE:=FALSE;
  1926.   WHILE(NOT DONE) AND (I<TOKSIZE) DO
  1927.     IF(ISALPHANUM(GETPBC(TOKEN[I]))) THEN
  1928.       I:=I+1
  1929.     ELSE
  1930.       DONE:=TRUE;
  1931.   IF(I>=TOKSIZE)THEN
  1932.     WRITELN('DEFINE:TOKEN TOO LONG');
  1933.   IF(I>1) THEN BEGIN (*SOME ALPHA WAS SEEN*)
  1934.     PUTBACK(TOKEN[I]);
  1935.     I:=I-1
  1936.   END;
  1937.   (*ELSE SINGLE NON-ALPHANUMERIC*)
  1938.   TOKEN[I+1]:=ENDSTR;
  1939.   GETTOK:=TOKEN[1]
  1940. END;
  1941.  
  1942. PROCEDURE PBSTR (VAR S:XSTRING);
  1943. VAR I:INTEGER;
  1944. BEGIN
  1945.   FOR I:=XLENGTH(S) DOWNTO 1 DO
  1946.     PUTBACK(S[I])
  1947. END;
  1948.  
  1949.  
  1950. FUNCTION HASH(VAR NAME:XSTRING):INTEGER;
  1951. VAR
  1952.   I,H:INTEGER;
  1953. BEGIN
  1954.   H:=0;
  1955.   FOR I:=1 TO XLENGTH(NAME) DO
  1956.     H:=(3*H+NAME[I]) MOD HASHSIZE;
  1957.   HASH:=H+1
  1958. END;
  1959.  
  1960. FUNCTION HASHFIND(VAR NAME:XSTRING):NDPTR;
  1961. VAR
  1962.   P:NDPTR;
  1963.   TEMPNAME:XSTRING;
  1964.   FOUND:BOOLEAN;
  1965. BEGIN
  1966.   FOUND:=FALSE;
  1967.   P:=HASHTAB[HASH(NAME)];
  1968.   WHILE (NOT FOUND) AND (P<>NIL) DO BEGIN
  1969.     CSCOPY(NDTABLE,P^.NAME,TEMPNAME);
  1970.     IF(EQUAL(NAME,TEMPNAME)) THEN
  1971.       FOUND:=TRUE
  1972.     ELSE
  1973.       P:=P^.NEXTPTR
  1974.   END;
  1975.   HASHFIND:=P
  1976. END;
  1977.  
  1978. PROCEDURE INITHASH;
  1979. VAR I:1..HASHSIZE;
  1980. BEGIN
  1981.   NEXTTAB:=1;
  1982.   FOR I:=1 TO HASHSIZE DO
  1983.     HASHTAB[I]:=NIL
  1984. END;
  1985.  
  1986. FUNCTION LOOKUP(VAR NAME,DEFN:XSTRING; VAR T:STTYPE)
  1987.  :BOOLEAN;
  1988. VAR P:NDPTR;
  1989. BEGIN
  1990.   P:=HASHFIND(NAME);
  1991.   IF(P=NIL)THEN
  1992.     LOOKUP:=FALSE
  1993.   ELSE BEGIN
  1994.     LOOKUP:=TRUE;
  1995.     CSCOPY(NDTABLE,P^.DEFN,DEFN);
  1996.     T:=P^.KIND
  1997.   END
  1998. END;
  1999.  
  2000.  
  2001. PROCEDURE INSTALL(VAR NAME,DEFN:XSTRING;T:STTYPE);
  2002. VAR
  2003.   H,DLEN,NLEN:INTEGER;
  2004.   P:NDPTR;
  2005. BEGIN
  2006.   NLEN:=XLENGTH(NAME)+1;
  2007.   DLEN:=XLENGTH(DEFN)+1;
  2008.   IF(NEXTTAB + NLEN +DLEN > MAXCHARS) THEN BEGIN
  2009.     PUTSTR(NAME,STDERR);
  2010.     ERROR(':TOO MANY DEFINITIONS')
  2011.   END
  2012.   ELSE BEGIN
  2013.     H:=HASH(NAME);
  2014.     NEW(P);
  2015.     P^.NEXTPTR:=HASHTAB[H];
  2016.     HASHTAB[H]:=P;
  2017.     P^.NAME:=NEXTTAB;
  2018.     SCCOPY(NAME,NDTABLE,NEXTTAB);
  2019.     NEXTTAB:=NEXTTAB+NLEN;
  2020.     P^.DEFN:=NEXTTAB;
  2021.     SCCOPY(DEFN,NDTABLE,NEXTTAB);
  2022.     NEXTTAB:=NEXTTAB+DLEN;
  2023.     P^.KIND:=T
  2024.   END
  2025. END;
  2026.  
  2027.  
  2028.  
  2029. PROCEDURE DODEF(VAR ARGSTK:POSBUF;I,J:INTEGER);
  2030. VAR
  2031.   TEMP1,TEMP2 : XSTRING;
  2032. BEGIN
  2033.   IF(J-I>2) THEN BEGIN
  2034.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP1);
  2035.     CSCOPY(EVALSTK,ARGSTK[I+3],TEMP2);
  2036.     INSTALL(TEMP1,TEMP2,MACTYPE)
  2037.   END
  2038. END;
  2039.   
  2040.  
  2041. PROCEDURE DOIF(VAR ARGSTK:POSBUF;I,J:INTEGER);
  2042. VAR
  2043.   TEMP1,TEMP2,TEMP3:XSTRING;
  2044. BEGIN
  2045.   IF(J-I>=4) THEN BEGIN
  2046.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP1);
  2047.     CSCOPY(EVALSTK,ARGSTK[I+3],TEMP2);
  2048.     IF(EQUAL(TEMP1,TEMP2))THEN
  2049.       CSCOPY(EVALSTK,ARGSTK[I+4],TEMP3)
  2050.     ELSE IF (J-I>=5) THEN
  2051.       CSCOPY(EVALSTK,ARGSTK[I+5],TEMP3)
  2052.     ELSE
  2053.       TEMP3[I]:=ENDSTR;
  2054.     PBSTR(TEMP3)
  2055.   END
  2056. END;
  2057.  
  2058. PROCEDURE PBNUM(N:INTEGER);
  2059. VAR
  2060.   TEMP:XSTRING;
  2061.   JUNK:INTEGER;
  2062. BEGIN
  2063.   JUNK:=ITOC(N,TEMP,1);
  2064.   PBSTR(TEMP)
  2065. END;
  2066. FUNCTION EXPR(VAR S:XSTRING;VAR I:INTEGER):INTEGER;FORWARD;
  2067.  
  2068. PROCEDURE DOEXPR(VAR ARGSTK:POSBUF;I,J:INTEGER);
  2069. VAR
  2070.   JUNK:INTEGER;
  2071.   TEMP:XSTRING;
  2072. BEGIN
  2073.   CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
  2074.   JUNK:=1;
  2075.   PBNUM(EXPR(TEMP,JUNK))
  2076. END;
  2077.  
  2078. FUNCTION EXPR;
  2079. VAR
  2080.   V:INTEGER;
  2081.   T:CHARACTER;
  2082.   
  2083. FUNCTION GNBCHAR(VAR S:XSTRING;VAR I:INTEGER):CHARACTER;
  2084. BEGIN
  2085.   WHILE(S[I]IN[BLANK,TAB,NEWLINE])DO
  2086.     I:=I+1;
  2087.   GNBCHAR:=S[I]
  2088. END;
  2089.  
  2090. FUNCTION TERM(VAR S:XSTRING;VAR I:INTEGER):INTEGER;
  2091. VAR
  2092.   V:INTEGER;
  2093.   T:CHARACTER;
  2094.  
  2095. FUNCTION FACTOR (VAR S:XSTRING;VAR I:INTEGER):
  2096.   INTEGER;
  2097. BEGIN
  2098.   IF(GNBCHAR(S,I)=LPAREN) THEN BEGIN
  2099.     I:=I+1;
  2100.     FACTOR:=EXPR(S,I);
  2101.     IF(GNBCHAR(S,I)=RPAREN) THEN
  2102.       I:=I+1
  2103.     ELSE
  2104.       WRITELN('MACRO:MISSING PAREN IN EXPR')
  2105.   END
  2106.   ELSE
  2107.     FACTOR:=CTOI(S,I)
  2108. END;(*FACTOR*)
  2109.  
  2110. BEGIN(*TERM*)
  2111.   V:=FACTOR(S,I);
  2112.   T:=GNBCHAR(S,I);
  2113.   WHILE(T IN [STAR,SLASH,PERCENT]) DO BEGIN
  2114.     I:=I+1;
  2115.     CASE T OF
  2116.       STAR:V:=V*FACTOR(S,I);
  2117.     SLASH:
  2118.       V:=V DIV FACTOR(S,I);
  2119.     PERCENT:
  2120.       V:=V MOD FACTOR(S,I)
  2121.     END;
  2122.     T:=GNBCHAR(S,I)
  2123.   END;
  2124.   TERM:=V
  2125. END;(*TERM*)
  2126.  
  2127. BEGIN(*EXPR*)
  2128.   V:=TERM(S,I);
  2129.   T:=GNBCHAR(S,I);
  2130.   WHILE(T IN [PLUS,MINUS])DO BEGIN
  2131.     I:=I+1;
  2132.     IF(T IN [PLUS]) THEN
  2133.       V:=V+TERM(S,I)
  2134.     ELSE(*MINUS*)
  2135.       V:=V-TERM(S,I);
  2136.     T:=GNBCHAR(S,I)
  2137.   END;
  2138.   EXPR:=V
  2139. END;
  2140.  
  2141. PROCEDURE DOLEN(VAR ARGSTK:POSBUF;I,J:INTEGER);
  2142. VAR
  2143.   TEMP:XSTRING;
  2144. BEGIN
  2145.   IF(J-I>1)THEN BEGIN
  2146.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
  2147.     PBNUM(XLENGTH(TEMP))
  2148.   END
  2149.   ELSE
  2150.     PBNUM(0)
  2151. END;
  2152.   
  2153.  
  2154. PROCEDURE DOSUB(VAR ARGSTK:POSBUF;I,J:INTEGER);
  2155. VAR
  2156.   AP,FC,K,NC:INTEGER;
  2157.   TEMP1,TEMP2:XSTRING;
  2158. BEGIN
  2159.   IF(J-I>=3) THEN BEGIN
  2160.     IF(J-I<4) THEN
  2161.       NC:=MAXTOK
  2162.     ELSE BEGIN
  2163.       CSCOPY(EVALSTK,ARGSTK[I+4],TEMP1);
  2164.       K:=1;
  2165.       NC:=EXPR(TEMP1,K)
  2166.     END;
  2167.     CSCOPY(EVALSTK,ARGSTK[I+3],TEMP1);
  2168.     AP:=ARGSTK[I+2];
  2169.     K:=1;
  2170.     FC:=AP+EXPR(TEMP1,K)-1;
  2171.     CSCOPY(EVALSTK,AP,TEMP2);
  2172.     IF(FC>=AP) AND (FC<AP+XLENGTH(TEMP2)) THEN BEGIN
  2173.       CSCOPY(EVALSTK,FC,TEMP1);
  2174.       FOR K:=FC+MIN(NC,XLENGTH(TEMP1))-1 DOWNTO FC DO
  2175.         PUTBACK(EVALSTK[K])
  2176.       END
  2177.     END
  2178.   END;
  2179.   
  2180.   PROCEDURE DOCHQ(VAR ARGSTK:POSBUF;I,J:INTEGER);
  2181.   VAR
  2182.     TEMP:XSTRING;
  2183.     N:INTEGER;
  2184.   BEGIN
  2185.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
  2186.     N:=XLENGTH(TEMP);
  2187.     IF(N<=0)THEN BEGIN
  2188.       LQUOTE:=ORD(LESS);
  2189.       RQUOTE:=ORD(GREATER)
  2190.     END
  2191.     ELSE IF (N=1) THEN BEGIN
  2192.       LQUOTE:=TEMP[1];
  2193.       RQUOTE:=LQUOTE
  2194.     END
  2195.     ELSE BEGIN
  2196.       LQUOTE:=TEMP[1];
  2197.       RQUOTE:=TEMP[2]
  2198.     END
  2199.   END;
  2200.   
  2201.   
  2202. PROCEDURE EVAL(VAR ARGSTK:POSBUF;TD:STTYPE;
  2203.   I,J:INTEGER);
  2204. VAR
  2205.   ARGNO,K,T:INTEGER;
  2206.   TEMP:XSTRING;
  2207. BEGIN
  2208.   T:=ARGSTK[I];
  2209.   IF(TD=DEFTYPE)THEN
  2210.     DODEF(ARGSTK,I,J)
  2211.   ELSE IF (TD=EXPRTYPE)THEN
  2212.     DOEXPR(ARGSTK,I,J)
  2213.   ELSE IF (TD=SUBTYPE) THEN
  2214.     DOSUB(ARGSTK,I,J)
  2215.   ELSE IF (TD=IFTYPE) THEN
  2216.     DOIF(ARGSTK,I,J)
  2217.   ELSE IF (TD=LENTYPE) THEN
  2218.     DOLEN(ARGSTK,I,J)
  2219.   ELSE IF (TD=CHQTYPE) THEN
  2220.     DOCHQ(ARGSTK,I,J)
  2221.   ELSE BEGIN
  2222.     K:=T;
  2223.     WHILE(EVALSTK[K]<>ENDSTR) DO
  2224.       K:=K+1;
  2225.     K:=K-1;
  2226.     WHILE(K>T) DO BEGIN
  2227.       IF(EVALSTK[K-1] <> ARGFLAG) THEN
  2228.         PUTBACK(EVALSTK[K])
  2229.       ELSE BEGIN
  2230.         ARGNO:=ORD(EVALSTK[K])-ORD('0');
  2231.         IF(ARGNO>=0) AND (ARGNO <J-I)THEN BEGIN
  2232.           CSCOPY(EVALSTK,ARGSTK[I+ARGNO+1],TEMP);
  2233.           PBSTR(TEMP)
  2234.         END;
  2235.         K:=K-1
  2236.       END;
  2237.       K:=K-1
  2238.     END;
  2239.     IF(K=T)THEN
  2240.       PUTBACK(EVALSTK[K])
  2241.     END
  2242.   END;
  2243. PROCEDURE INITMACRO;
  2244.   BEGIN
  2245.     NULL[1]:=ENDSTR;
  2246.       DEFNAME[1]:=ORD('d');
  2247.       DEFNAME[2]:=ORD('e');
  2248.       DEFNAME[3]:=ORD('f');
  2249.       DEFNAME[4]:=ORD('i');
  2250.       DEFNAME[5]:=ORD('n');
  2251.       DEFNAME[6]:=ORD('e');
  2252.       DEFNAME[7]:=ENDSTR;
  2253.       SUBNAME[1]:=ORD('s');
  2254.       SUBNAME[2]:=ORD('u');
  2255.       SUBNAME[3]:=ORD('b');
  2256.       SUBNAME[4]:=ORD('s');
  2257.       SUBNAME[5]:=ORD('t');
  2258.       SUBNAME[6]:=ORD('r');
  2259.       SUBNAME[7]:=ENDSTR;
  2260.       EXPRNAME[1]:=ORD('e');
  2261.       EXPRNAME[2]:=ORD('x');
  2262.       EXPRNAME[3]:=ORD('p');
  2263.       EXPRNAME[4]:=ORD('r');
  2264.       EXPRNAME[5]:=ENDSTR;
  2265.       IFNAME[1]:=ORD('i');
  2266.       IFNAME[2]:=ORD('f');
  2267.       IFNAME[3]:=ORD('e');
  2268.       IFNAME[4]:=ORD('l');
  2269.       IFNAME[5]:=ORD('s');
  2270.       IFNAME[6]:=ORD('e');
  2271.       IFNAME[7]:=ENDSTR;
  2272.       LENNAME[1]:=ORD('l');
  2273.       LENNAME[2]:=ORD('e');
  2274.       LENNAME[3]:=ORD('n');
  2275.       LENNAME[4]:=ENDSTR;
  2276.       CHQNAME[1]:=ORD('c');
  2277.       CHQNAME[2]:=ORD('h');
  2278.       CHQNAME[3]:=ORD('a');
  2279.       CHQNAME[4]:=ORD('n');
  2280.       CHQNAME[5]:=ORD('g');
  2281.       CHQNAME[6]:=ORD('e');
  2282.       CHQNAME[7]:=ORD('q');
  2283.       CHQNAME[8]:=ENDSTR;
  2284.     BP:=0;
  2285.     INITHASH;
  2286.     LQUOTE:=ORD('`');
  2287.     RQUOTE:=ORD('''')
  2288.   END;
  2289.   
  2290.       
  2291.  
  2292.   
  2293. BEGIN
  2294.   INITMACRO;
  2295.   INSTALL(DEFNAME,NULL,DEFTYPE);
  2296.   INSTALL(EXPRNAME,NULL,EXPRTYPE);
  2297.   INSTALL(SUBNAME,NULL,SUBTYPE);
  2298.   INSTALL(IFNAME,NULL,IFTYPE);
  2299.   INSTALL(LENNAME,NULL,LENTYPE);
  2300.   INSTALL(CHQNAME,NULL,CHQTYPE);
  2301.   
  2302.   CP:=0;AP:=1;EP:=1;
  2303.   
  2304.   WHILE(GETTOK(TOKEN,MAXTOK)<>ENDFILE)DO
  2305.     IF(ISLETTER(TOKEN[1]))THEN BEGIN
  2306.       IF(NOT LOOKUP(TOKEN,DEFN,TOKTYPE))THEN
  2307.         PUTTOK(TOKEN)
  2308.       ELSE BEGIN
  2309.         CP:=CP+1;
  2310.         IF(CP>CALLSIZE)THEN
  2311.           ERROR('MACRO:CALL STACK OVERFLOW');
  2312.         CALLSTK[CP]:=AP;
  2313.         TYPESTK[CP]:=TOKTYPE;
  2314.         AP:=PUSH(EP,ARGSTK,AP);
  2315.         PUTTOK(DEFN);
  2316.         PUTCHR(ENDSTR);
  2317.         AP:=PUSH(EP,ARGSTK,AP);
  2318.         PUTTOK(TOKEN);
  2319.         PUTCHR(ENDSTR);
  2320.         AP:=PUSH(EP,ARGSTK,AP);
  2321.         T:=GETTOK(TOKEN,MAXTOK);
  2322.         PBSTR(TOKEN);
  2323.         IF(T<>LPAREN)THEN BEGIN
  2324.           PUTBACK(RPAREN);
  2325.           PUTBACK(LPAREN)
  2326.         END;
  2327.         PLEV[CP]:=0
  2328.       END
  2329.     END
  2330.     ELSE IF(TOKEN[1]=LQUOTE) THEN BEGIN
  2331.       NLPAR:=1;
  2332.       REPEAT
  2333.         T:=GETTOK(TOKEN,MAXTOK);
  2334.         IF(T=RQUOTE)THEN
  2335.           NLPAR:=NLPAR-1
  2336.         ELSE IF (T=LQUOTE)THEN
  2337.           NLPAR:=NLPAR+1
  2338.         ELSE IF (T=ENDFILE) THEN
  2339.           ERROR('MACRO:MISSING RIGHT QUOTE');
  2340.         IF(NLPAR>0) THEN
  2341.           PUTTOK(TOKEN)
  2342.       UNTIL(NLPAR=0)
  2343.     END
  2344.     ELSE IF (CP=0)THEN
  2345.       PUTTOK(TOKEN)
  2346.     ELSE IF (TOKEN[1]=LPAREN) THEN BEGIN
  2347.       IF(PLEV[CP]>0)THEN
  2348.         PUTTOK(TOKEN);
  2349.       PLEV[CP]:=PLEV[CP]+1
  2350.     END
  2351.     ELSE IF (TOKEN[1]=RPAREN)THEN BEGIN
  2352.       PLEV[CP]:=PLEV[CP]-1;
  2353.       IF(PLEV[CP]>0)THEN
  2354.         PUTTOK(TOKEN)
  2355.       ELSE BEGIN
  2356.         PUTCHR(ENDSTR);
  2357.         EVAL(ARGSTK,TYPESTK[CP],CALLSTK[CP],AP-1);
  2358.         AP:=CALLSTK[CP];
  2359.         EP:=ARGSTK[AP];
  2360.         CP:=CP-1
  2361.       END
  2362.     END
  2363.     ELSE IF (TOKEN[1]=COMMA) AND (PLEV[CP]=1)THEN BEGIN
  2364.       PUTCHR(ENDSTR);
  2365.       AP:=PUSH(EP,ARGSTK,AP)
  2366.     END
  2367.     ELSE
  2368.       PUTTOK(TOKEN);
  2369.   IF(CP<>0)THEN
  2370.     ERROR('MACRO:UNEXPECTED END OF INPUT')
  2371. END;
  2372.  
  2373.  
  2374.  
  2375.  
  2376.  
  2377. SHAR_EOF
  2378. if test 12030 -ne "`wc -c < 'chapter8.pas'`"
  2379. then
  2380.     echo shar: error transmitting "'chapter8.pas'" '(should have been 12030 characters)'
  2381. fi
  2382. fi # end of overwriting check
  2383. #    End of shell archive
  2384. exit 0
  2385.